home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / Xmath.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-14  |  7.3 KB  |  286 lines
  1. #pragma segment Xmath
  2. /*
  3.  * math.c --
  4.  *
  5.  * Mathematical Tcl commands.
  6.  *---------------------------------------------------------------------------
  7.  * Copyright 1991 Karl Lehenbauer and Mark Diekhans.
  8.  *
  9.  * Permission to use, copy, modif-, and distribute this software and its
  10.  * documentation for any purpose and without fee is hereby granted, provided
  11.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12.  * Mark Diekhans make no representations about the suitability of this
  13.  * software for any purpose.  It is provided "as is" without express or
  14.  * implied warranty.
  15.  */
  16.  
  17. #include <QuickDraw.h>
  18. #include <OSUtils.h>
  19. #include <math.h>
  20. #include <values.h>
  21.  
  22. #include "tcl.h"
  23.  
  24. extern int rand();
  25.  
  26. /*
  27.  * Prototypes of internal -unctions.
  28.  */
  29. int 
  30. really_random _ANSI_ARGS_((int my_range));
  31.  
  32.  
  33. /*
  34.  *----------------------------------------------------------------------
  35.  *
  36.  * Tcl_MaxCmd --
  37.  *      Implements the TCL max command:
  38.  *        max num1 num2 [..numN]
  39.  *
  40.  * Results:
  41.  *      Standard TCL results.
  42.  *
  43.  *----------------------------------------------------------------------
  44.  */
  45. int
  46. Tcl_MaxCmd (clientData, interp, argc, argv)
  47.     ClientData  clientData;
  48.     Tcl_Interp *interp;
  49.     int         argc;
  50.     char      **argv;
  51. {
  52.     double value, maxVal = MINDOUBLE;
  53.     int    idx, maxIdx = 1;
  54.  
  55.  
  56.     if (argc < 3) {
  57.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  58.                           " num1 num2 [..numN]", (char *) NULL);
  59.         return TCL_ERROR;
  60.     }
  61.  
  62.     for (idx = 1; idx < argc; idx++) {
  63.         if (Tcl_GetDouble (interp, argv[idx], &value) != TCL_OK)
  64.             return TCL_ERROR;
  65.         if (value > maxVal) {
  66.             maxVal = value;
  67.             maxIdx = idx;
  68.             }
  69.         }
  70.     strcpy (interp->result, argv[maxIdx]);
  71.     return TCL_OK;
  72. }
  73.  
  74. /*
  75.  *----------------------------------------------------------------------
  76.  *
  77.  * Tcl_MinCmd --
  78.  *     Implements the TCL min command:
  79.  *         min num1 num2 [..numN]
  80.  *
  81.  * Results:
  82.  *      Standard TCL results.
  83.  *
  84.  *----------------------------------------------------------------------
  85.  */
  86. int
  87. Tcl_MinCmd (clientData, interp, argc, argv)
  88.     ClientData  clientData;
  89.     Tcl_Interp *interp;
  90.     int     argc;
  91.     char      **argv;
  92. {
  93.     double value, minVal = MAXDOUBLE;
  94.     int    idx, minIdx = 1;
  95.  
  96.     if (argc < 3) {
  97.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  98.                           " num1 num2 [..numN]", (char *) NULL);
  99.         return TCL_ERROR;
  100.     }
  101.  
  102.     for (idx = 1; idx < argc; idx++) {
  103.         if (Tcl_GetDouble (interp, argv[idx], &value) != TCL_OK)
  104.             return TCL_ERROR;
  105.         if (value < minVal) {
  106.             minVal = value;
  107.             minIdx = idx;
  108.             }
  109.         }
  110.     strcpy (interp->result, argv[minIdx]);
  111.     return TCL_OK;
  112. }
  113.  
  114. /*
  115.  *----------------------------------------------------------------------
  116.  *
  117.  * ReallyRandom --
  118.  *     Insure a good random return for a range, unlike an arbitrary
  119.  *     random() % n, thanks to Ken Arnold, Unix Review, October 1987.
  120.  *
  121.  *----------------------------------------------------------------------
  122.  */
  123. #define RANDOM_RANGE ((1 << 15) - 1)
  124.  
  125. static int 
  126.  
  127. ReallyRandom (myRange)
  128.     int myRange;
  129. {
  130.     int maxMultiple, rnum;
  131.  
  132.     maxMultiple = RANDOM_RANGE / myRange;
  133.     maxMultiple *= myRange;
  134.     while ((rnum = Random()) >= maxMultiple)
  135.         continue;
  136.     return (rnum % myRange);
  137. }
  138.  
  139. /*
  140.  *----------------------------------------------------------------------
  141.  *
  142.  * TclRandomCmd  --
  143.  *     Implements the TCL random command:
  144.  *     random limit
  145.  *
  146.  * Results:
  147.  *  Standard TCL results.
  148.  *
  149.  *----------------------------------------------------------------------
  150.  */
  151. int
  152. Tcl_RandomCmd (clientData, interp, argc, argv)
  153.     ClientData  clientData;
  154.     Tcl_Interp *interp;
  155.     int         argc;
  156.     char      **argv;
  157. {
  158.     unsigned range;
  159.  
  160.     if ((argc < 2) || (argc > 3))
  161.         goto invalidArgs;
  162.  
  163.     if (strcmp(argv[1], "seed") == 0) {
  164.         unsigned long seed;
  165.  
  166.         if (argc == 3) {
  167.             if (Tcl_GetLong (interp, argv[2], &seed) != TCL_OK)
  168.                 return TCL_ERROR;
  169.             }
  170.         else
  171.             {
  172.             GetDateTime(&seed);
  173.             qd.randSeed = seed;
  174.             }
  175.         }
  176.     else {
  177.         if (argc != 2)
  178.             goto invalidArgs;
  179.         if (Tcl_GetUnsigned (interp, argv[1], &range) != TCL_OK)
  180.             return TCL_ERROR;
  181.         if ((range == 0) || (range > RANDOM_RANGE))
  182.             goto outOfRange;
  183.  
  184.         sprintf (interp->result, "%d", ReallyRandom(range));
  185.         }
  186.     return TCL_OK;
  187.  
  188. invalidArgs:
  189.     Tcl_AppendResult (interp, "wrong # args: ", argv [0], 
  190.                       " limit | seed [seedval]", (char *) NULL);
  191.     return TCL_ERROR;
  192. outOfRange:
  193.     {
  194.         char buf [18];
  195.  
  196.         sprintf (buf, "%d", RANDOM_RANGE);
  197.         Tcl_AppendResult (interp, argv [0], ": range must be > 0 and <= ",
  198.                           buf, (char *) NULL);
  199.         return TCL_ERROR;
  200.     }
  201. }
  202.  
  203.  
  204. /*
  205.  *----------------------------------------------------------------------
  206.  *
  207.  * Tcl_GetUnsigned --
  208.  *
  209.  *      Given a string, produce the corresponding unsigned integer value.
  210.  *
  211.  * Results:
  212.  *      The return value is normally TCL_OK;  in this case *intPtr
  213.  *      will be set to the integer value equivalent to string.  If
  214.  *      string is improperly formed then TCL_ERROR is returned and
  215.  *      an error message will be left in interp->result.
  216.  *
  217.  * Side effects:
  218.  *      None.
  219.  *
  220.  *----------------------------------------------------------------------
  221.  */
  222. int
  223. Tcl_GetUnsigned(interp, string, unsignedPtr)
  224.     Tcl_Interp *interp;         /* Interpret-r to use for error reporting. */
  225.     CONST char *string;         /* String containing a (possibly signed)
  226.                                  * integer in a form acceptable to strtoul. */
  227.     unsigned   *unsignedPtr;    /* Place to store converted result. */
  228. {
  229.     char          *end;
  230.     unsigned long  i;
  231.  
  232.     i = strtoul(string, &end, 0);
  233.     while ((*end != '\0') && isspace(*end)) {
  234.         end++;
  235.     }
  236.     if ((end == string) || (*end != 0)) {
  237.         Tcl_AppendResult (interp, "expected unsigned integer but got \"", 
  238.                           string, "\"", (char *) NULL);
  239.         return TCL_ERROR;
  240.     }
  241.     *unsignedPtr = i;
  242.     return TCL_OK;
  243. }
  244.  
  245.  
  246. /*
  247.  *----------------------------------------------------------------------
  248.  *
  249.  * Tcl_GetLong --
  250.  *
  251.  *      Given a string, produce the corresponding long value.
  252.  *
  253.  * Results:
  254.  *      The return value is normally TCL_OK;  in this case *intPtr
  255.  *      will be set to the integer value equivalent to string.  If
  256.  *      string is improperly formed then TCL_ERROR is returned and
  257.  *      an error message will be left in interp->result.
  258.  *
  259.  * Side effects:
  260.  *      None.
  261.  *
  262.  *----------------------------------------------------------------------
  263.  */
  264. int
  265. Tcl_GetLong(interp, string, longPtr)
  266.     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
  267.     CONST char *string;         /* String containing a (possibly signed)
  268.                                  * integer in a form acceptable to strtol. */
  269.     long       *longPtr;        /* Place to store converted result. */
  270. {
  271.     char *end;
  272.     long  i;
  273.  
  274.     i = strtol(string, &end, 0);
  275.     while ((*end != '\0') && isspace(*end)) {
  276.         end++;
  277.     }
  278.     if ((end == string) || (*end != 0)) {
  279.         Tcl_AppendResult (interp, "expected integer but got \"", string,
  280.                           "\"", (char *) NULL);
  281.         return TCL_ERROR;
  282.     }
  283.     *longPtr = i;
  284.     return TCL_OK;
  285. }
  286.